home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / COMPILER / VP10B003 / VPC.ZIP / EXAMPLES / TEST / TESTDOS.PAS < prev    next >
Pascal/Delphi Source File  |  1995-06-22  |  6KB  |  180 lines
  1. {█▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀█}
  2. {█                                                       █}
  3. {█      Virtual Pascal Examples. Version 1.0.            █}
  4. {█      Dos unit test example.                           █}
  5. {█      ─────────────────────────────────────────────────█}
  6. {█      Copyright (C) 1995 B&M&T Corporation             █}
  7. {█      ─────────────────────────────────────────────────█}
  8. {█      Written by Vitaly Miryanov                       █}
  9. {█                                                       █}
  10. {▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀}
  11.  
  12. program TestDos;
  13.  
  14. uses Dos, Use32;
  15.  
  16. var
  17.   Ver,Attr,Attr1: Word;
  18.   Y,M,D,DoW: Word;
  19.   Y1,M1,D1,DoW1: Word;
  20.   H,H1,S,S1,Hund,Hund1: Word;
  21.   i: Integer;
  22.   Size: Longint;
  23.   Verify,Verify1: Boolean;
  24.   F: Text;
  25.   DT: DateTime;
  26.   FTime: Longint;
  27.   SR: SearchRec;
  28.   FName: PathStr;
  29. const
  30.   Days: array [0..6] of String[9] =
  31.     ('Sunday','Monday','Tuesday', 'Wednesday','Thursday','Friday', 'Saturday');
  32.   OffOn : array [Boolean] of String[3] = ('off','on');
  33.  
  34. function ConvertTime(Hour,Minute,Second,Sec100: Word): String;
  35. var
  36.   I: Integer;
  37.   S1,S2: String[20];
  38. begin
  39.   Str(Hour:2, S1);
  40.   Str(Minute:2, S2);
  41.   S1 := S1 + ':' + S2;
  42.   Str(Second:2, S2);
  43.   S1 := S1 + ':' + S2;
  44.   Str(Sec100:2, S2);
  45.   S1 := S1 + ':' + S2;
  46.   for i := 1 to Length(S1) do if S1[i] = ' ' then S1[i] := '0';
  47.   ConvertTime := S1;
  48. end;
  49.  
  50. procedure TestFSplit(const FName: PathStr);
  51. var
  52.   Dir: DirStr;
  53.   Name: NameStr;
  54.   Ext: ExtStr;
  55. begin
  56.   FSplit(FName, Dir, Name, Ext);
  57.   WriteLn('Full name: ',FName, ' Dir="',Dir, '" Name="',Name, '" Ext="',Ext,'"');
  58. end;
  59.  
  60. begin
  61.   { DosVersion }
  62.   Ver := DosVersion;
  63.   WriteLn('OS/2 version ', Lo(Ver) div 10, '.', Hi(Ver), ' is running.');
  64.   { GetDate }
  65.   GetDate(Y, M, D, DoW);
  66.   WriteLn('Today is ', Days[DoW],', ', M:0, '/', D:0, '/', Y:0, '.');
  67.   { SetDate }
  68.   SetDate(2000, 1, 1);
  69.   GetDate(Y1, M1, D1, DoW1);
  70.   WriteLn('1/1/2000 is ', Days[DoW1], '.');
  71.   SetDate(Y, M, D);
  72.   { GetTime }
  73.   GetTime(H, M, S, Hund);
  74.   WriteLn('Current time is ', ConvertTime(H, M, S, Hund), '.');
  75.   { SetTime }
  76.   SetTime(0, 0, 0, 0);
  77.   GetTime(H1, M1, S1, Hund1);
  78.   WriteLn('Oooooorrrrrr, it''s time to sleep for a while: time is ', ConvertTime(H1, M1, S1, Hund1), '.');
  79.   SetTime(H, M, S, Hund);
  80.   { GetVerify/SetVerify }
  81.   GetVerify(Verify);
  82.   WriteLn('Write verify is ', OffOn[Verify],'.');
  83.   Verify := not(Verify);
  84.   Write('Turning write verify ', OffOn[Verify],' ... ');
  85.   SetVerify(Verify);
  86.   GetVerify(Verify1);
  87.   if Verify = Verify1 then WriteLn(' done.')
  88.                       else WriteLn(' failed.');
  89.   SetVerify(not Verify);
  90.   { DiskFree/DiskSize }
  91.   for I := 3 to 26 do
  92.   begin
  93.     Size := DiskSize(i);
  94.     if Size = -1 then Break;
  95.     WriteLn('Drive ' , Chr(I + Ord('A') - 1), ':   '
  96.           + 'Size = ', Size div 1024:9, 'K  '
  97.           + 'Free = ', DiskFree(I) div 1024:9, 'K.');
  98.   end;
  99.   { GetFAttr/SetFAttr }
  100.   Assign(F, 'C:\AUTOEXEC.BAT');
  101.   GetFAttr(F, Attr1);
  102.   WriteLn('Lets make our C:\AUTOEXEC.BAT file read only ...');
  103.   if DosError = 0 then
  104.   begin
  105.     SetFAttr(F, Attr1 or ReadOnly);
  106.     if DosError = 0 then
  107.     begin
  108.       GetFAttr(F, Attr);
  109.       if DosError = 0 then
  110.       begin
  111.         Write('C:\AUTOEXEC.BAT attributes = ', Attr);
  112.         if Attr and ReadOnly <> 0 then Write(' ReadOnly');
  113.         if Attr and Hidden   <> 0 then Write(' Hidden');
  114.         if Attr and SysFile  <> 0 then Write(' System');
  115.         if Attr and Archive  <> 0 then Write(' Archive');
  116.         WriteLn;
  117.         SetFAttr(F,Attr1);
  118.       end;
  119.     end;
  120.   end;
  121.   if DosError <> 0 then WriteLn('Error getting/setting file attributes, EC =', DosError);
  122.   { GetFTime/SetFTime }
  123.   WriteLn('Creating temporary file TEST.$$$ ...');
  124.   Assign(F,'TEST.$$$');
  125.   Rewrite(F);                   { Create new file   }
  126.   GetFTime(F, FTime);           { Get creation time }
  127.   UnpackTime(FTime, DT);
  128.   with DT do
  129.   begin
  130.     WriteLn('File datestamp is ', Month:0, '/', Day:0, '/', Year:0, '.');
  131.     WriteLn('File timestamp is ', ConvertTime(Hour,Min,Sec,0), '.');
  132.     Hour := 0;
  133.     Min := 1;
  134.     Sec := 0;
  135.     PackTime(DT, FTime);
  136.     WriteLn('Setting file timestamp to one minute after midnight');
  137.     Reset(F);                   { Reopen file for reading }
  138.     SetFTime(F, FTime);         { (Otherwise, close will update time) }
  139.   end;
  140.   Close(F);   { Close file }
  141.   { FindFirst/FindNext/FindClose }
  142.   WriteLn('List of all files and directories in the current directory');
  143.   WriteLn('          Name       Size');
  144.   FindFirst('*.*', AnyFile, SR);
  145.   while DosError = 0 do
  146.   begin
  147.     WriteLn(SR.Name:14, SR.Size:11);
  148.     FindNext(SR);
  149.   end;
  150. {$IFDEF OS2}
  151.   FindClose(SR);
  152. {$ENDIF}
  153.   { FSearch/GetEnv }
  154.   FName := FSearch('cmd.exe', GetEnv('Path'));
  155.   if FName = '' then WriteLn('CMD.EXE is not found')
  156.                 else WriteLn('CMD.EXE full path is ', FName);
  157.   { EnvStr/EnvCount }
  158.   WriteLn('List of all environment variables');
  159.   for I := 1 to EnvCount do WriteLn(I:0, ': ', EnvStr(I));
  160.   { FExpand }
  161.   WriteLn('Fully qualified name for the "..\.\QQ" is ', FExpand('..\.\qq'));
  162.   WriteLn('Fully qualified name for the "QQ"      is ', FExpand('qq'));
  163.   WriteLn('Fully qualified name for the "\QQ"     is ', FExpand('\qq'));
  164.   WriteLn('Fully qualified name for the "C:QQ"    is ', FExpand('c:qq'));
  165.   { FSplit }
  166.   TestFSplit('D:\DIR\FILENAME.EXT');
  167.   TestFSplit('D:\DIR.EXT\FILENAME');
  168.   TestFSplit('DIR\FILENAME.EXT');
  169.   TestFSplit('\FILENAME.EXT');
  170.   TestFSplit('FILENAME.EXT');
  171.   TestFSplit('FILENAME');
  172.   { Exec/ExitCode }
  173.   WriteLn('DIR *.* /P');
  174. {$IFDEF OS2}
  175.   ExecFlags := efAsync;
  176. {$ENDIF}
  177.   Exec(GetEnv('COMSPEC'), '/C dir *.* /P');
  178.   WriteLn('ExitCode = ', DosExitCode);
  179. end.
  180.